The PC-SIG Library 10

home *** CD-ROM | disk | FTP | other *** search

/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 04 / 3 / DISK0431.ZIP / GRF.BQS / grf.bas

Wrap

BASIC Source File | 1985-02-28 | 26KB | 581 lines

10 ' 20 ' This is a demo program which (in conjunction with the PCDOS GRAPHICS 30 ' utility for hard copy) generates line graphs. Up to 5 graphs with 40 ' different symbols may be plotted on the same plot. The program can 50 ' read numerically saved AnalytiCalc spreadsheets or its own saved 60 ' format files. When using, the function keys usually need a <return> 70 ' after them to get them to be acted on. BASICA of PCDOS 2.0 or later 80 ' is required. If it bombs, check to see the screen limits of display 90 ' make sense. Logs of negative numbers may result if the screen is set 100 'up for linear display; reset the limits. Everything is pretty much 110 ' menu driven and works adequately. Note however this is a demo and 120 ' you may modify it to your needs as you like. The linear regression 130 ' option allows you to fit a line to a data set and tell how good a 140 ' fit it is. Finally, a one-dimensional plot is a histogram. A two 150 ' dimensional plot is a scatterplot. You need to enter spreadsheet 160 ' coordinate limits numerically for plots, so column A is 1, B is 2, 170 ' and so on. You can work with up to 5 sets of up to 100 points at 180 ' a time. Color display is used, so change if you have a problem. 680 '----------------------------------------------------------- 690 ' 700 DIM X(100),Y(100),X1(100),Y1(100) 710 DIM XX(5,100),YY(5,100) 720 DIM LTYPESET(5),SIZESET(5),SYMSET(5),NPTSET(5) 730 DIM SYM$(10),LTYPE$(5),CORNER$(4) 740 ' 750 ON ERROR GOTO 3770 760 KEY OFF:WIDTH 80 770 ON KEY (1) GOSUB 3780 780 ON KEY (2) GOSUB 3790 790 ON KEY (3) GOSUB 3850 800 ON KEY (4) GOSUB 3880 810 ON KEY (5) GOSUB 3910 820 ON KEY (6) GOSUB 3930 830 ON KEY (7) GOSUB 3950 840 ON KEY (8) GOSUB 3970 850 ON KEY (9) GOSUB 3990 860 ON KEY (10) GOSUB 4010 870 ON KEY (11) GOSUB 4030 880 KEY (1) ON:KEY (2) ON:KEY (3) ON:KEY (4) ON:KEY (5) ON 890 KEY (6) ON:KEY (7) ON:KEY (8) ON:KEY (9) ON:KEY (10) ON 900 KEY (11) ON 910 SCREEN 0:CLS:COLOR 13,0,1:LOCATE 5,18: 920 PRINT "GRAPH a general plotting program" 930 X$=STRING$(70,205) 940 COLOR 12,0,1:LOCATE 2,6:PRINT X$; 950 SYM$(0)="none":SYM$(1)="open square":SYM$(3)="open triangle":SYM$(5)="open circle" 960 SYM$(9)="X":SYM$(7)="open diamond":SYM$(2)="filled square":SYM$(4)="filled triangle":SYM$(6)="filled circle":SYM$(8)="filled diamond" 970 LTYPE$(0)="none":LTYPE$(1)="solid":LTYPE$(2)="dashed":LTYPE$(3)="dotted" 980 CORNER$(0)="none":CORNER$(1)="lower left":CORNER$(2)="upper left" 990 CORNER$(3)="lower right":CORNER$(4)="upper right" 1000 DATASET=1 1010 HELP=1 1020 LTYPE$(4)="regression" 1030 XMIN=.1:XMAX=99:XLIN=0:XLEN=7 1040 YMIN=.1:YMAX=99:YLIN=0:YLEN=5.5 1050 FOR I=1 TO 5 1060 SIZESET(I)=1.5:LTYPESET(I)=1 1070 SYMSET(I)=I 1080 NEXT I 1090 LOCATE 23,6:PRINT X$; 1100 LOCATE 2,5:PRINT CHR$(201);:LOCATE 2,75:PRINT CHR$(187); 1110 LOCATE 23,5:PRINT CHR$(200);:LOCATE 23,75:PRINT CHR$(188); 1120 FOR I=1 TO 20:LOCATE 2+I,5:PRINT CHR$(186);:NEXT I 1130 FOR I=1 TO 20:LOCATE 2+I,75:PRINT CHR$(186);:NEXT I 1140 COLOR 13,0,1:LOCATE 10,25:PRINT "Version 2.2";:LOCATE 20,28:PRINT "Hit any key to start" 1150 LOCATE 24,1 1160 A$=INKEY$:IF A$="" THEN 1160 1170 ' 1180 ' now display menu of plot specifications 1190 ' 1200 SCREEN 0:COLOR 1,0,0:CLS:SCREEN 0:CLS:COLOR 15,1,1:PRINT "GRAPH 2.2" 1210 PRINT STRING$(80,205); 1220 IF DATASET<1 OR DATASET>5 THEN 1240 1230 SYM=SYMSET(DATASET):SIZE=SIZESET(DATASET):LTYPE=LTYPESET(DATASET) 1240 COLOR 13,0,1:PRINT "Plot specification parameters:" 1250 PRINT " 1. Symbol Type : ";SYM$(SYMSET(DATASET)) 1260 PRINT " 2. Symbol size is ";SIZESET(DATASET);" % of axis length" 1270 PRINT " 3. Line type : ";LTYPE$(LTYPESET(DATASET)) 1280 PRINT " 4. Label line 1 :";LAB1$ 1290 PRINT " 5. Label line 2 :";LAB2$ 1300 PRINT " 6. Label line 3 :";LAB3$ 1310 PRINT " 7. Corner for label : ";CORNER$(CORNER) 1320 PRINT " 8. Working on data set : ";DATASET 1330 COLOR 10,0,1:PRINT "X axis parameters:" 1340 PRINT " 9. X axis length =";XLEN;" inches" 1350 PRINT " 10. Minimum value =";XMIN 1360 PRINT " 11. Maximum value =";XMAX 1370 IF XLIN=0 THEN PRINT " 12. Linear X axis" 1380 IF XLIN=1 THEN PRINT " 12. Logarithmic X axis" 1390 PRINT " 13. X axis label :";XLAB$ 1400 COLOR 12,0,1:PRINT "Y axis parameters :" 1410 PRINT " 14. Y axis length =";YLEN;" inches" 1420 PRINT " 15. Minimum value =";YMIN 1430 PRINT " 16. Maximum value =";YMAX 1440 IF YLIN=0 THEN PRINT " 17. Linear Y axis" 1450 IF YLIN=1 THEN PRINT " 17. Logarithmic Y axis" 1460 PRINT " 18. Y axis label :";YLAB$ 1470 IF HELP=1 THEN GOSUB 4050 'help menu display 1480 LOCATE 25,2:COLOR 14,0,1:INPUT "Change number (0=none) :";CHNG 1490 IF CHNG=0 THEN 2780 1500 ON CHNG GOTO 1520,1710,1550,1560,1570,1580,1590,1700,1600,1610,1620,1630,1640,1650,1660,1670,1680,1690 1510 GOTO 1200 1520 PRINT "Symbol type (0=none,1=open sq,2=fill sq,3=open tri,4=fill tri" 1530 INPUT " 5=open cir,6=fill cir,7=open diam,8=fill diam,9=X) :";SYM 1540 SYMSET(DATASET)=SYM:GOTO 1200 1550 INPUT "Line type (0=none,1=solid,2=dashed,3=dotted,4=regression) :";LTYPE:LTYPESET(DATASET)=LTYPE:GOTO 1200 1560 INPUT "Label line 1 :";LAB1$:GOTO 1200 1570 INPUT "label line 2 :";LAB2$:GOTO 1200 1580 INPUT "Label line 3 :";LAB3$:GOTO 1200 1590 INPUT "corner for label (0=none,1=LL,2=UL,3=LR,4=UR) :";CORNER:GOTO 1170 1600 INPUT "Length of X axis in inches :";XLEN:GOTO 1200 1610 INPUT "Minimum X value :";XMIN:GOTO 1200 1620 INPUT "maximum X value :";XMAX:GOTO 1200 1630 XLIN=1-XLIN:GOTO 1200 1640 INPUT "X axis label :";XLAB$:GOTO 1200 1650 INPUT "Length of Y axis in inches :";YLEN:GOTO 1200 1660 INPUT "Minimum Y value :";YMIN:GOTO 1200 1670 INPUT "Maximum Y value :";YMAX:GOTO 1200 1680 YLIN=1-YLIN:GOTO 1200 1690 INPUT "Y axis label :";YLAB$:GOTO 1200 1700 INPUT "Number of data set to edit (1-5) :";DATASET:GOTO 1200 1710 INPUT "Symbol size (% of axes length) ";SIZE:SIZESET(DATASET)=SIZE:GOTO 1200 1720 ' 1730 ' Read in data from disk file 1740 ' 1750 CLS:COLOR 0,7,1:PRINT :LOCATE 2,20:PRINT " READ DATA IN FROM DISK FILE ":PRINT :COLOR 14,0,1 1760 PRINT "Files on this disk :":PRINT 1770 FILES 1780 PRINT 1790 INPUT "Name of input data file ";DATAIN$:IF DATAIN$="" THEN 1790 1800 INPUT "AnalytiCalc Save File (A) or Data File (D)";ND$ 1810 ND$=LEFT$(ND$,1) 1820 NSV=1:IF ND$ = "A" THEN INPUT "Enter saveset number 1-5>";NSV 1830 IF ND$ <> "A" THEN GOTO 1920 1840 NXL=1:NXH=18000:NYL=1:NYH=18000:INPUT "1 OR 2 DIMENSION PLOT";NDM 1850 INPUT "Enter low, high range for Y axis spreadsheet COLS";NYL,NYH 1860 INPUT "Enter low, high range for Y axis spreadsheet ROWS";NXL,NXH 1870 IF NDM < 2 THEN GOTO 1920 1880 INPUT "Enter low, high range for X axis spreadsheet COLS";MYL,MYH 1890 INPUT "Enter low, high range for X axis spreadsheet ROWS";MXL,MXH 1900 ' NOW LIMIT INPUT TO THESE RANGES. 1910 ' 1920 DATASET=NSV 1930 IF ND$ = "A" THEN GOTO 2040 1940 'DATAIN$=DATAIN$+".dta" 1950 OPEN DATAIN$ FOR INPUT AS #1 1960 FOR I=1 TO 5 1970 INPUT #1,NPTSET(I),SYMSET(I),SIZESET(I),LTYPESET(I) 1980 FOR J=1 TO NPTSET(I) 1990 INPUT #1,XX(I,J),YY(I,J) 2000 NEXT J 2010 NEXT I 2020 CLOSE #1 2030 GOTO 2970 2040 ' ANALYTICALC INPUT FILES... INPUT AND ASSUME ONLY ONE ROW OR COLUMN THERE. 2050 NPT=0:ON ERROR GOTO 2330 2060 OPEN DATAIN$ FOR INPUT AS #1 2070 LINE INPUT #1,T$ 2080 INPUT #1,I1$,I2 2090 LINE INPUT #1,L$ 2100 INPUT #1,TP,F$,TY 2110 ' I1$ IS PNN, NN=ONE OFFSET, AND I2 IS OTHER OFFSET FOR SAVE CELL NO. 2120 I1=VAL(RIGHT$(I1$,5)) 2130 IF TP <= 0 AND NPT < 100 THEN GOTO 2080 2140 ' SKIP LABEL RECORDS 2150 IF I1 < NYL OR I1 > NYH THEN GOTO 2080 2160 IF I2 < NXL OR I2 > NXH THEN GOTO 2080 2170 YV=VAL(L$):XV=NPT 2180 IF NDM = 1 THEN GOTO 2220 2190 IF I1 < MYL OR I1 > MYH THEN GOTO 2080 2200 IF I2 < MXL OR I2 > MXH THEN GOTO 2080 2210 XV=VAL(L$) 2220 IF NPT=100 THEN PRINT "Max 100 points reached":GOTO 2330 2230 ' HERE HAVE VALUES TO PLOT, SO INSERT INTO ARRAY. 2280 NPT=NPT+1:XX(NSV,NPT)=XV:YY(NSV,NPT)=YV 2320 GOTO 2080 2330 NPTSET(NSV)=NPT 2340 CLOSE #1 2350 GOTO 2970 2360 ' 2370 ' Write out data to disk file 2380 ' 2390 CLS:COLOR 0,7,1:PRINT :LOCATE 2,20:PRINT " WRITE CURRENT DATA OUT TO DISK FILE ":PRINT:COLOR 14,0,1 2400 PRINT "Files on this disk:":PRINT 2410 FILES 2420 INPUT "Name of output data file ";DATAOUT$:IF DATAOUT$="" THEN 2420 2430 DATAOUT$=DATAOUT$+".dta" 2440 OPEN DATAOUT$ FOR OUTPUT AS #1 2450 FOR I=1 TO 5 2460 WRITE #1,NPTSET(I),SYMSET(I),SIZESET(I),LTYPESET(I) 2470 FOR J=1 TO NPTSET(I) 2480 WRITE #1,XX(I,J),YY(I,J) 2490 NEXT J 2500 NEXT I 2510 CLOSE #1 2520 GOTO 2970 2530 ' 2540 ' read in plot specs from disk file 2550 ' 2560 CLS:COLOR 0,7,1:PRINT :LOCATE 2,15:PRINT " READ IN PLOT SPECIFICATIONS FROM DISK FILE ":PRINT :COLOR 14,0,1 2570 PRINT "Specification files on this disk:":PRINT 2580 FILES"*.spc 2590 INPUT "Name of file with plot specifications ";PLOTSPEC$ 2600 IF PLOTSPEC$="" THEN 2590 2610 PLOTSPEC$=PLOTSPEC$+".spc" 2620 OPEN PLOTSPEC$ FOR INPUT AS #1 2630 INPUT #1,SYM,SIZE,LTYPE,XLEN,XMIN,XMAX,XLIN,XINC,XLAB$,YLEN,YMIN,YMAX,YLIN,YLAB$,LAB1$,LAB2$,LAB3$,CORNER 2640 CLOSE #1 2650 GOTO 1200 2660 ' 2670 ' write out current plot specs to disk file for future use 2680 ' 2690 CLS:COLOR 0,7,1:PRINT :LOCATE 2,15:PRINT " WRITE CURRENT PLOT SPECIFICATIONS OUT TO DISK FILE ":PRINT :COLOR 14,0,1 2700 PRINT " Specification files on this disk :":PRINT 2710 FILES"*.spc 2720 INPUT "Name of disk file for plot specifications output ";OUTSPEC$ 2730 OUTSPEC$=OUTSPEC$+".spc" 2740 OPEN OUTSPEC$ FOR OUTPUT AS #1 2750 WRITE #1,SYM,SIZE,LTYPE,XLEN,XMIN,XMAX,XLIN,XINC,XLAB$,YLEN,YMIN,YMAX,YLIN,YLAB$,LAB1$,LAB2$,LAB3$,CORNER 2760 CLOSE #1 2770 GOTO 1200 2780 ' 2790 ' Input data and allow editing 2800 ' 2810 IF NPTSET(DATASET)>=1 THEN 2970 2820 COLOR 1,0,0:CLS:SCREEN 0:CLS:IF HELP=1 THEN GOSUB 4050 2830 LOCATE 23,1:PRINT "Data Set ";DATASET:INPUT "How many data points :",NPTS 2840 IF NPTS=0 THEN 3510 2850 NPTSET(DATASET)=NPTS 2860 IF NPTS=-1 THEN GOTO 1730 2870 IF NPTS<-1 THEN 2790 2880 PRINT "Data Set Number ";DATASET 2890 FOR I=1 TO NPTS 2900 COLOR 10,0,1:PRINT I;". ";:INPUT "X value ";XX(DATASET,I) 2910 COLOR 12,0,1:INPUT " Y value ";YY(DATASET,I) 2920 PRINT 2930 NEXT I 2940 ' 2950 ' Display data for editing 2960 ' 2970 CLS:SCREEN 0:COLOR 15,1,1 2980 IF NPTSET(DATASET)<1 THEN GOTO 2830 2990 PRINT " I X(I) Y(I)";:PRINT STRING$(63,32); 3000 X$=STRING$(80,205):PRINT X$ 3010 SX=0:SY=0:SSX=0:SXY=0 3020 NPTS=NPTSET(DATASET) 3030 IF HELP=1 THEN GOSUB 4050 'help menu display 3040 FOR I=1 TO NPTSET(DATASET) 3050 LOCATE ((I-1) MOD 20)+3,1+(18*FIX((I-1)/20)):COLOR 14,0,1:PRINT I;"."; 3060 LOCATE ((I-1) MOD 20)+3,8+(18*FIX((I-1)/20)):COLOR 10,0,1:PRINT XX(DATASET,I); 3070 LOCATE ((I-1) MOD 20)+3,14+(18*FIX((I-1)/20)):COLOR 12,0,1:PRINT YY(DATASET,I); 3080 IF LTYPESET(DATASET)<>4 THEN 3120 3090 XTEMP=XX(DATASET,I):YTEMP=YY(DATASET,I):IF XLIN=1 THEN XTEMP=LOG(XX(DATASET,I))/LOG(10) 3100 IF YLIN=1 THEN YTEMP=LOG(YY(DATASET,I))/LOG(10) 3110 SX=SX+XTEMP:SY=SY+YTEMP:SSX=SSX+(XTEMP^2):SXY=SXY+(XTEMP*YTEMP) 3120 NEXT I 3130 IF LTYPESET(DATASET)<>4 THEN 3230 3140 A=((NPTS*SXY)-(SX*SY))/((NPTS*SSX)-(SX*SX)) 3150 B=(SY/NPTS)-(A*SX/NPTS):SD=0 3160 FOR I=1 TO NPTS 3170 XTEMP=XX(DATASET,I):IF XLIN=1 THEN XTEMP=LOG(XX(DATASET,I))/LOG(10) 3180 YTEMP=YY(DATASET,I):IF YLIN=1 THEN YTEMP=LOG(YY(DATASET,I))/LOG(10) 3190 SD=SD+((YTEMP-((A*XTEMP)+B))^2) 3200 SD=SD+((YTEMP-((A*XTEMP)+B))^2) 3210 NEXT I 3220 SD=SQR(SD)/NPTS 3230 COLOR 10,0,1:LOCATE 23,2:PRINT "Data set ";DATASET;" Symbol : ";SYM$(SYMSET(DATASET));" Size : ";SIZESET(DATASET);"% Line type : ";LTYPE$(LTYPESET(DATASET)); 3240 LGX$=" ":IF XLIN=1 THEN LGX$="log" 3250 LGY$=" ":IF YLIN=1 THEN LGY$="log" 3260 IF LTYPESET(DATASET)=4 THEN COLOR 13,0,1:LOCATE 24,2:PRINT "Regression :";LGY$;" Y = ";:PRINT USING "#####.###";A;:PRINT " *";LGX$;" X + ";:PRINT USING "#####.###";B;:PRINT " avg dev = ";:PRINT USING "####.###";SD; 3270 COLOR 14,0,1 3280 LOCATE 25,2:INPUT "Change number (0 for none,-1 for sort) :";CHNG 3290 CLS:IF CHNG=0 THEN GOTO 3510 3300 IF CHNG>0 THEN 3440 3310 ' 3320 ' Sort the data 3330 ' 3340 LOCATE 12,30:PRINT "Sorting ...." 3350 FOR I=1 TO NPTS 3360 FOR J=1 TO NPTS 3370 IF XX(DATASET,J)>XX(DATASET,I) THEN TEMP=XX(DATASET,J):XX(DATASET,J)=XX(DATASET,I):XX(DATASET,I)=TEMP:TEMP=YY(DATASET,J):YY(DATASET,J)=YY(DATASET,I):YY(DATASET,I)=TEMP 3380 NEXT J 3390 NEXT I 3400 GOTO 2970 3410 ' 3420 ' Get new value for data point 3430 ' 3440 IF CHNG>NPTS THEN NPTSET(DATASET)=NPTSET(DATASET)+1:CHNG=NPTSET(DATASET) 3450 PRINT "Input new values for point ";CHNG 3460 PRINT :PRINT :INPUT "X value ";XX(DATASET,CHNG) 3470 INPUT "Y value ";YY(DATASET,CHNG) 3480 GOTO 2970 3490 ' 3500 ' 3510 ' Now go to subplot subroutine to plot 3520 ' 3530 KLR=15 3540 FOR DSET=1 TO 5 3550 I=DSET 3560 SYM=SYMSET(I) 3570 SIZE=SIZESET(I) 3580 LTYPE=LTYPESET(I) 3590 NPTS=NPTSET(I) 3600 FOR J=1 TO NPTSET(I) 3610 X(J)=XX(I,J):Y(J)=YY(I,J) 3620 NEXT J 3630 MORE=0 3640 IF I>1 THEN MORE=1 3650 GOSUB 4290 3660 NEXT DSET 3670 ' 3680 ' display graph until any key pressed (including function keys) 3690 ' 3700 A$=INKEY$:IF A$="" THEN 3700 ELSE 1200 3710 ' 3720 ' 3730 ' This section contains subroutines executed on errors 3740 ' and on key traps. 3750 ' 3760 ' 3770 IF ERR=5 OR ERR=53 THEN RESUME NEXT ELSE ON ERROR GOTO 0 3780 RETURN 3510 'f1 - plot data 3790 'exit program - return to DOS 3800 PRINT :PRINT "WARNING ! You will lose any unsaved data if you exit !" 3810 PRINT " do you really want to exit (y or n) ? "; 3820 A$=INKEY$:IF A$="" THEN 3820 3830 IF A$="n" OR A$="N" THEN 1180 ELSE SYSTEM 3840 'f2 - exit program - return to DOS 3850 DATASET=DATASET-1:IF DATASET<1 THEN DATASET=1:BEEP 3860 ' f3 - decrease data set number by one 3870 RETURN 2810 3880 'f4 - Next data set 3890 DATASET=DATASET+1:IF DATASET>5 THEN DATASET=5:BEEP 3900 RETURN 2810 3910 'f5 - load specifications from file 3920 RETURN 2540 3930 'f6 - save specifications in file 3940 RETURN 2680 3950 'f7 - load data from file 3960 RETURN 1730 3970 'f8 - save data in file 3980 RETURN 2370 3990 'f9 - go to specifications menu 4000 RETURN 1180 4010 'f10 - go to data display for current data set 4020 RETURN 2810 4030 ' <up cursor> key - help screen toggle 4040 HELP=1-HELP:RETURN 4050 ' 4060 ' help menu display 4070 ' 4080 COLOR 15,1,1 4090 LOCATE 1,58:PRINT " FUNCTION KEYS "; 4100 LOCATE 2,58:PRINT " "; 4110 X$=STRING$(19,196) 4120 LOCATE 4,58:PRINT " PLOT EXIT TO "; 4130 LOCATE 5,58:PRINT " FIGURE DOS "; 4140 LOCATE 7,58:PRINT " DECR INCR "; 4150 LOCATE 8,58:PRINT " DATASET DATASET "; 4160 LOCATE 10,58:PRINT " LOAD SPEC SAVE SPEC "; 4170 LOCATE 11,58:PRINT " FILE FILE "; 4180 LOCATE 13,58:PRINT " LOAD DATA SAVE DATA "; 4190 LOCATE 14,58:PRINT " FILE FILE "; 4200 LOCATE 16,58:PRINT " SPEC DATA "; 4210 LOCATE 17,58:PRINT " MENU MENU "; 4220 LOCATE 20,58:PRINT "<up cursor>=help toggle"; 4230 LOCATE 19,58:PRINT "Alt-C = Color Increment"; 4240 LOCATE 3,58:PRINT " "+CHR$(218)+X$+CHR$(191); 4250 FOR I.H=6 TO 15 STEP 3:LOCATE I.H,58:PRINT " "+X$+" ";:NEXT 4260 LOCATE 18,58:PRINT " "+CHR$(192)+X$+CHR$(217); 4270 FOR I.C=60 TO 80 STEP 10:FOR I.R=4 TO 17:LOCATE I.R,I.C:PRINT CHR$(179);:NEXT :NEXT 4280 RETURN 4290 ' graphics display routine. Plots data and draws grid. 4380 ' 4390 ' Alt-C controls the color of the plot, the entire figure is 4400 ' plotted in the chosen color. The color option does not 4410 ' affect the printer dump print density. 4420 '--------------------------------------------------------------- 4430 'Calling sequence: 4470 ' gosub 4290 at point where you want the plot 4500 'Parameters: Do not use these names elsewhere in your program 4510 ' 4520 ' SYM symbol type (0=none,1=open sq,2=fill sq,3=open tri 4530 ' 4=fill tri,5=open cir,6=fill cir 4540 ' 7=open diamond,8=filled diamond,9=X 4550 ' SIZE Symbol size in % of axes length 4560 ' LTYPE line type (0=none,1=solid,2=dashed,3=dotted,4=regressio 4570 ' NPTS is the number of data points 4580 ' X(I),Y(I) arrays that contain the x and y data points 4590 ' XLEN,YLEN x and y axis length in inches 4600 ' XMIN,YMIN x any y minimum values 4610 ' XMAX,YMAX x and y axis maximum values 4620 ' XLIN,YLIN flag for linear(=0) or Log(=1) axis 4630 ' XINC,YINC unit increment on each axis (valid only for linear) 4640 ' if these are <=0 they are calculated from data 4650 ' XLAB$,YLAB$ strings containing the axis labels 4660 ' LAB1$,LAB2$,LAB3$ three label lines 4670 ' CORNER specifies the corner for the label 4680 ' (0=none,1=LL,2=LR,3=UL,4=UR) 4690 ' MORE a flag that indicates whether this call is the 4700 ' first and so axes should be plotted, or if it 4710 ' is more data to go on the same axes (axes are 4720 ' not plotted if MORE=1), MORE=0 new figure. 4730 ' 4740 ' For more than one set of data on the same axes: 4750 ' 1. Set up the first set of data and all other plot parameters 4760 ' 2. GOSUB 4290 with MORE=0 4770 ' 3. Set up second set of data (leave plot parameters unchanged) 4780 ' (you may change SYM, SIZE, LTYPE and NPTS for each set) 4790 ' 4. GOSUB 4290 with MORE=1 4800 ' 5. repeat steps 3 and 4 for each additional data set 4810 ' 4820 '---------------------------------------------------------------- 4830 ' 4840 ' 4850 ' Scale axes and plot them 4860 ' 4870 IF YLEN<=0 THEN YLEN=5.5 4880 IF XLEN<=0 THEN XLEN=7.5 4890 IF MORE<>1 THEN SCREEN 2:CLS:KEY OFF 4900 KEY 20,CHR$(&H8)+CHR$(46):KEY (20) ON 4910 ON KEY (20) GOSUB 6430 4920 IF KLR.P=0 THEN KLR.P=15 4930 OUT 985,KLR.P 4940 XINC.P=XINC:YINC.P=YINC 4950 XRANGE.P=XMAX-XMIN:YRANGE.P=YMAX-YMIN 4960 IF XINC<=0 THEN XINC.P=10^(INT(LOG(XRANGE.P*.66)/LOG(10))) 4970 IF YINC<=0 THEN YINC.P=10^(INT(LOG(YRANGE.P*.66)/LOG(10))) 4980 XMIN.P=XINC.P*INT(XMIN/XINC.P):XMAX.P=XINC.P*(INT((XMAX/XINC.P)+1)) 4990 YMAX.P=YINC.P*INT((YMAX/YINC.P)+1):YMIN.P=YINC.P*(INT(YMIN/YINC.P)) 5000 IF XLIN=1 THEN XMAX.P=LOG(XMAX)/LOG(10):XMIN.P=LOG(XMIN)/LOG(10) 5010 IF YLIN=1 THEN YMAX.P=LOG(YMAX)/LOG(10):YMIN.P=LOG(YMIN)/LOG(10) 5020 XRANGE.P=XMAX.P-XMIN.P:YRANGE.P=YMAX.P-YMIN.P 5030 DX=SIZE*XRANGE.P/100!:DY=SIZE*YRANGE.P/100! 5040 XT.P=XRANGE.P*(9!/XLEN):YT.P=YRANGE.P*(7!/YLEN) 5050 TICX=.03*XRANGE.P:TICY=.04*YRANGE.P 5060 XTRA=(XT.P-XRANGE.P)*9/XT.P:YTRA=(YT.P-YRANGE.P)*7/YT.P 5070 LBD.X=XMIN.P-(1!*XT.P/9) 5080 LBD.Y=YMIN.P-(1!*YT.P/7) 5090 UBD.X=XMAX.P+((XTRA-1!)*XT.P/9):UBD.Y=YMAX.P+((YTRA-1!)*YT.P/7) 5100 IF MORE<>1 THEN WINDOW (LBD.X,LBD.Y)-(UBD.X,UBD.Y) 5110 IF MORE<>1 THEN LINE (XMIN.P,YMIN.P)-(XMAX.P,YMAX.P),1,B 5120 XLOW.P=XMIN.P-LBD.X:YLOW.P=YMIN.P-LBD.Y 5130 XHI.P=XT.P-XRANGE.P-XLOW.P:YHI.P=YT.P-YRANGE.P-YLOW.P 5140 XP.P=.00161*(UBD.X-LBD.X) 5150 IF MORE<>1 THEN LINE (XMIN.P+XP.P,YMIN.P)-(XMAX.P+XP.P,YMAX.P),1,B 5160 STYLE=&HFFFF:IF LTYPE=0 THEN STYLE=&H0 5170 IF LTYPE=2 THEN STYLE=&HF0F0 5180 IF LTYPE=3 THEN STYLE=&HC0C0 5190 IF LTYPE=4 THEN STYLE=&H0 5200 IF MORE=1 THEN 6140 5210 ' 5220 'label axes 5230 ' 5240 XPOS.P=((XLOW.P+(XRANGE.P/2!))*80!/XT.P)-(LEN(XLAB$)/2) 5250 LOCATE 25,XPOS.P:PRINT XLAB$; 5260 YPOS.P=25!-(25!*((YLOW.P+(YRANGE.P/2!))/YT.P))-(LEN(YLAB$)/2!) 5270 FOR I=1 TO LEN(YLAB$):YT$=MID$(YLAB$,I,1):LOCATE I+YPOS.P,3:PRINT YT$;:NEXT I 5280 ' 5290 ' Print label on figure in specified corner 5300 ' 5310 ' 5320 IF CORNER=0 THEN GOTO 5460 5330 MAXLEN=0:IF LEN(LAB3$)>MAXLEN THEN MAXLEN=LEN(LAB3$) 5340 IF LEN(LAB2$)>MAXLEN THEN MAXLEN=LEN(LAB2$)+1 5350 IF LEN(LAB1$)>MAXLEN THEN MAXLEN=LEN(LAB1$)+1 5360 IF CORNER=1 OR CORNER=2 THEN XPOS.P=((XLOW.P/XT.P)*80!)+3 5370 IF CORNER=3 OR CORNER=4 THEN XPOS.P=(((XLOW.P+XRANGE.P)/XT.P)*80!)-MAXLEN 5380 IF CORNER=2 OR CORNER=4 THEN YPOS.P=((YHI.P/YT.P)*26)+2 5390 IF CORNER=1 OR CORNER=3 THEN YPOS.P=(((YHI.P+YRANGE.P)/YT.P)*26!)-4! 5400 LOCATE YPOS.P,XPOS.P:PRINT LAB1$; 5410 LOCATE YPOS.P+1,XPOS.P:PRINT LAB2$; 5420 LOCATE YPOS.P+2,XPOS.P:PRINT LAB3$; 5430 ' 5440 ' tic marks and numbers on linear x axis 5450 ' 5460 IF XLIN=1 THEN 5640 5470 FOR XTIC=XMIN.P TO XMAX.P STEP XINC.P 5480 LINE (XTIC,YMIN.P)-(XTIC,YMIN.P+TICY),1 5490 LINE (XTIC+XP.P,YMIN.P)-(XTIC+XP.P,YMIN.P+TICY),1 5500 LINE (XTIC,YMAX.P-TICY)-(XTIC,YMAX.P),1 5510 LINE (XTIC+XP.P,YMAX.P-TICY)-(XTIC+XP.P,YMAX.P),1 5520 IF XTIC<XMIN.P+XINC.P THEN 5580 5530 HALF.P=XTIC-(.5*XINC.P) 5540 LINE (HALF.P,YMIN.P)-(HALF.P,YMIN.P+(TICY/2)),1 5550 LINE (HALF.P+XP.P,YMIN.P)-(HALF.P+XP.P,YMIN.P+(TICY/2)),1 5560 LINE (HALF.P,YMAX.P-(TICY/2))-(HALF.P,YMAX.P),1 5570 LINE (HALF.P+XP.P,YMAX.P-(TICY/2))-(HALF.P+XP.P,YMAX.P),1 5580 XPOS.P=(((XLOW.P+(XTIC-XMIN.P))/XT.P)*80!)-(LEN(STR$(XTIC))/2) 5590 LOCATE 23,XPOS.P:PRINT XTIC; 5600 NEXT XTIC 5610 ' 5620 ' tic marks and numbers on linear y axis 5630 ' 5640 IF YLIN=1 THEN 5820 5650 FOR YTIC=YMIN.P TO YMAX.P STEP YINC.P 5660 LINE (XMIN.P,YTIC)-(XMIN.P+TICX,YTIC),1 5670 LINE (XMAX.P-TICX,YTIC)-(XMAX.P,YTIC),1 5680 IF YTIC<YMIN.P+YINC.P THEN 5720 5690 HALF.P=YTIC-(YINC.P/2) 5700 LINE (XMIN.P,HALF.P)-(XMIN.P+(TICX/2),HALF.P),1 5710 LINE (XMAX.P-(TICX/2),HALF.P)-(XMAX.P,HALF.P),1 5720 YPOS.P=((YHI.P+(YMAX.P-YTIC))/YT.P)*26! 5730 XPOS.P=6-(LEN(STR$(YTIC))/2) 5740 IF YPOS.P>25 OR YPOS.P<1 THEN BEEP:GOTO 5770 5750 IF XPOS.P>80 OR XPOS.P<1 THEN BEEP:GOTO 5770 5760 LOCATE YPOS.P,XPOS.P:PRINT YTIC 5770 NEXT YTIC 5780 ' 5790 ' tic marks and numbers on log x axis 5800 ' 5810 ' 5820 IF XLIN=0 THEN 5980 5830 FOR CYC=-5 TO 5 5840 FOR LTIC=1 TO 10 5850 XTIC=LTIC*(10^CYC) 5860 LXTIC=LOG(XTIC)/LOG(10) 5870 IF LXTIC<=XMIN.P OR LXTIC>=XMAX.P THEN 5920 5880 LINE (LXTIC,YMIN.P)-(LXTIC,YMIN.P+TICY),1 5890 LINE (LXTIC+XP.P,YMIN.P)-(LXTIC+XP.P,YMIN.P+TICY),1 5900 LINE (LXTIC,YMAX.P-TICY)-(LXTIC,YMAX.P),1 5910 LINE (LXTIC+XP.P,YMAX.P-TICY)-(LXTIC+XP.P,YMAX.P),1 5920 NEXT LTIC 5930 IF LXTIC>=XMIN.P AND LXTIC<=XMAX.P THEN LOCATE 23,(((XLOW.P+(LXTIC-XMIN.P))/XT.P)*80!)-1:PRINT XTIC;:IF LXTIC+.5<=XMAX.P THEN LOCATE 23,(((XLOW.P+(LXTIC+.5-XMIN.P))/XT.P)*80)-1:PRINT 3!*XTIC; 5940 NEXT CYC 5950 ' 5960 ' tic marks and numbers on log y axis 5970 ' 5980 IF YLIN=0 THEN 6110 5990 FOR CYC=-5 TO 5 6000 FOR LTIC=1 TO 10 6010 YTIC=LTIC*(10^CYC) 6020 LYTIC=LOG(YTIC)/LOG(10) 6030 IF LYTIC<=YMIN.P OR LYTIC>=YMAX.P THEN 6060 6040 LINE (XMIN.P,LYTIC)-(XMIN.P+TICX,LYTIC),1 6050 LINE (XMAX.P-TICX,LYTIC)-(XMAX.P,LYTIC),1 6060 NEXT LTIC 6070 YPOS.P=((YHI.P+(YMAX.P-LYTIC))/YT.P)*26! 6080 XPOS.P=6-((LEN(STR$(YTIC))/2!)) 6090 IF LYTIC>=YMIN.P AND LYTIC<=YMAX.P AND YPOS.P>=1 THEN LOCATE YPOS.P,XPOS.P:PRINT YTIC; 6100 NEXT CYC 6110 ' 6120 ' now plot data on axes 6130 ' 6140 SX=0:SY=0:SSX=0:SXY=0 6150 FOR I=1 TO NPTS 6160 X1(I)=X(I):IF XLIN=1 THEN X1(I)=LOG(X(I))/LOG(10) 6170 Y1(I)=Y(I):IF YLIN=1 THEN Y1(I)=LOG(Y(I))/LOG(10) 6180 IF I>1 THEN LINE(X1(I-1),Y1(I-1))-(X1(I),Y1(I)),1,,STYLE 6190 IF I>1 THEN LINE (X1(I-1)+XP.P,Y1(I-1))-(X1(I)+XP.P,Y1(I)),1,,STYLE 6200 IF SYM=1 THEN LINE (X1(I)-DX,Y1(I)-DY)-(X1(I)+DX,Y1(I)+DY),1,B 6210 IF SYM=1 OR SYM=2 THEN LINE(X1(I)-DX+XP.P,Y1(I)-DY)-(X1(I)+DX+XP.P,Y1(I)+DY),1,B 6220 IF SYM=2 THEN LINE(X1(I)-DX+XP.P,Y1(I)-DY)-(X1(I)+DX+XP.P,Y1(I)+DY),1,BF 6230 IF SYM=3 OR SYM=4 THEN LINE (X1(I)-DX,Y1(I)-DY)-(X1(I)+DX,Y1(I)-DY),1:LINE (X1(I),Y1(I)+DY)-(X1(I)-DX,Y1(I)-DY),1:LINE (X1(I),Y1(I)+DY)-(X1(I)+DX,Y1(I)-DY),1 6240 IF SYM=3 OR SYM=4 THEN LINE (X1(I)+XP.P,Y1(I)+DY)-(X1(I)+XP.P+DX,Y1(I)-DY),1:LINE (X1(I)+XP.P,Y1(I)+DY)-(X1(I)+XP.P-DX,Y1(I)-DY),1 6250 IF SYM=4 THEN PAINT (X1(I)+2*XP.P,Y1(I)),1 6260 IF SYM=5 OR SYM=6 THEN CIRCLE (X1(I),Y1(I)),DX:CIRCLE (X1(I)+XP.P,Y1(I)),DX 6270 IF SYM=6 THEN PAINT (X1(I)+2*XP.P,Y1(I)),1 6280 IF SYM=9 THEN LINE (X1(I)-DX,Y1(I)-DY)-(X1(I)+DX,Y1(I)+DY),1:LINE (X1(I)+DX,Y1(I)-DY)-(X1(I)-DX,Y1(I)+DY),1 6290 IF SYM=7 OR SYM=8 THEN LINE (X1(I),Y1(I)+DY)-(X1(I)+DX,Y1(I)),1:LINE -(X1(I),Y1(I)-DY),1:LINE -(X1(I)-DX,Y1(I)),1:LINE -(X1(I),Y1(I)+DY),1 6300 IF SYM=8 THEN PAINT (X1(I)+2*XP.P,Y1(I)),1 6310 SY=SY+Y1(I):SX=SX+X1(I):SSX=SSX+(X1(I)^2):SXY=SXY+(X1(I)*Y1(I)) 6320 NEXT I 6330 IF LTYPE<>4 THEN RETURN 6340 ' 6350 ' Regression line plotted 6360 A=((NPTS*SXY)-(SX*SY))/((NPTS*SSX)-(SX*SX)) 6370 B=(SY/NPTS)-(A*SX/NPTS) 6380 YMIN.P=(A*XMIN.P)+B:YMAX.P=(A*XMAX.P)+B 6390 LINE (XMIN.P,YMIN.P)-(XMAX.P,YMAX.P),1 6400 LINE (XMIN.P+XP.P,YMIN.P)-(XMAX.P+XP.P,YMAX.P),1 6410 ' 6420 RETURN 6430 ' 6440 ' key trap of Alt-C to change color 6450 ' 6460 KLR.P=(KLR.P+1) MOD 128:IF KLR.P MOD 8=0 OR KLR.P MOD 16=0 THEN KLR.P=KLR.P+1 6470 OUT 985,KLR.P 6480 RETURN